unit uViewSchematic ;

interface

uses
  Windows,
  Graphics,
  Types,
  Menus,
  Classes,
  Controls,
  Contnrs,
  VirtualTrees,
  uLayout,
  uBasic,
  uPlacement,
  uMouseHandler,
  GDIPAPI,
  GDIPOBJ ;

type

  TMedaPage = class( TMedaPlace )
  private
    fRevision : string ;
    fModified : TDateTime ;

    fNumber : TMedaPageNumber ;
    fSize : string ;
    fLandscape : boolean ;
    fPageWidth : integer ;
    fPageHeight : integer ;

    procedure SetLandscape( const Value : boolean ) ;
    procedure SetSize( Value : string ) ;
    procedure SetModified( const Value : TDateTime ) ;
    procedure SetRevision( const Value : string ) ;
  protected
    procedure Update ; override ;
    function GetPopupMenu : TPopupMenu ; override ;
  public
    function GetIcon : TIconType ; override ;
    function CheckType : TCheckType ; override ;
    procedure SetSelection( aFlag : TMedaState ) ; override ;
  public
    function Center( aRect : TGPRectF ) : TPoint ; override ;
    procedure PaintAt( aGraphics : TMedaGraphics ) ; override ;
  public
    constructor Create ;
    function Accept( Visitor : TObject ) : TObject ; override ;
    function InvalRect( aRect : TGPRectF ) : TGPRectF ; override ;

    property Size : string read FSize write SetSize ;
    property Landscape : boolean read FLandscape write SetLandscape ;
    property Revision : string read fRevision write SetRevision ;
    property Number : TMedaPageNumber read fNumber ;

    property Modified : TDateTime read fModified write SetModified ;
  end ;

  TMedaSchematicViewer = class ;
  TMedaSchInterface = class( TMedaViewable )
  private
    fParent : TMedaSchematicViewer ;
  protected
    procedure Update ; override ;
    function GetPopupMenu : TPopupMenu ; override ;
  public
    { Public declarations }
    constructor Create( aParent : TMedaSchematicViewer ) ;
    function GetName : string ; override ;
    function GetChild( index : integer ) : TMedaViewable ; override ;
    function GetChildCount : integer ; override ;
    function GetText( aColumn : integer ) : string ; override ;
    function GetIcon : TIconType ; override ;
    function GetColor : TGPColor ; override ;
  public
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
    procedure Mark ; override ;
  end ;

  TMedaSchematicViewer = class( TMedaViewer )
  private
    fProjectView : TMedaSchInterface ;
    fMedaPages : TObjectlist ;

    function GetPages( index : TMedaPageNumber ) : TMedaPage ;
    procedure SetCurrentPageIndex( const Value : TMedaPageNumber ) ;
    function GetCurrentPageIndex : TMedaPageNumber ;
    function GetCurrentPage : TMedaPage ;
    procedure SetCurrentPage( const aPage : TMedaPage ) ;
  protected
    { Protected declarations }
    function HitTest( aPoint : TGPPointF ) : TMedaViewList ; override ;
    procedure Paint ; override ;
  public
    { Public declarations }
    constructor Create( AOwner : TComponent ) ; override ;
    destructor Destroy ; override ;

    procedure CreateGraphics ; override ;

    property ProjectView : TMedaSchInterface read fProjectView ;
    function CanZoomIn : boolean ; override ;
    function CanZoomOut : boolean ; override ;

    procedure Clear ; override ;

    property Pages[ index : TMedaPageNumber ] : TMedaPage read GetPages ;
    function PageCount : integer ;
    function AddPage( aSize : string = 'a4' ; aLandscape : boolean = True ) : TMedaPage ;
    procedure DeletePage( aPageIndex : TMedaPageNumber ) ;

    procedure Remove( aObject : TMedaViewable ) ; override ;

    property CurrentPageIndex : TMedaPageNumber read GetCurrentPageIndex write SetCurrentPageIndex ;
    property CurrentPage : TMedaPage read GetCurrentPage write SetCurrentPage ;

    function PageByID( aPage : TGUID ) : TMedaPage ;
    function PageByName( aPage : string ) : TMedaPage ;
    function CanPlace : boolean ;
  end ;

var
  vsbSchematicViewer : TMedaSchematicViewer ;

implementation

uses
  uMain,
  uVisitor,
  uObjects,
  fmSchematic,
  SysUtils,
  Forms ;

var
  gTitlePen         : TGPPen ;
  gFontFamily       : TGPFontFamily ;
  gFontTitle        : TGPFont ;
  gTextBrush        : TGPSolidBrush ;

  { TSchematicPage }

constructor TMedaPage.Create ;
begin
  inherited ;
  fPageWidth := cPageWidth ;
  fPageHeight := cPageHeight ;
  fModified := Now ;
end ;

procedure TMedaPage.SetModified( const Value : TDateTime ) ;
begin
  fModified := Value ;
  Invalidate ;
end ;

procedure TMedaPage.SetRevision( const Value : string ) ;
begin
  fRevision := Value ;
  Invalidate ;
end ;

function TMedaPage.InvalRect( aRect : TGPRectF ) : TGPRectF ;
begin
  Result := vsbSchematicViewer.InvalRect( aRect ) ;
end ;

function TMedaPage.Center( aRect : TGPRectF ) : TPoint ;
begin
  vsbSchematicViewer.SetCurrentPage( Self ) ;
  Result := inherited Center( aRect ) ;
end ;

function TMedaPage.GetIcon : TIconType ;
begin
  Result := iconLayer ;
end ;

function TMedaPage.GetPopupMenu : TPopupMenu ;
begin
  Result := TPopupMenu( Accept( SchematicPopupVisitor as TSchematicPopupVisitor ) ) ;
end ;

function TMedaPage.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

function TMedaPage.CheckType : TCheckType ;
begin
  Result := ctRadioButton ;
end ;

procedure TMedaPage.PaintAt( aGraphics : TMedaGraphics ) ;
const
  PortraitLandscape : array[ boolean ] of string = ( 'Portrait', 'Landscape' ) ;
var
  ptF               : TGPPointF ;
  s                 : string ;
  iPageWidth, iPageHeight : integer ;
begin
  inherited ;
  iPageWidth := fPageWidth - 2 * cSchGrid ;
  iPageHeight := fPageHeight - 2 * cSchGrid ;

  with aGraphics.MemGraphics do begin
    TranslateTransform( cSchGrid, cSchGrid ) ;
    DrawRectangle( gTitlePen, 0, 0, iPageWidth, iPageHeight ) ;
    DrawLine( gTitlePen, iPageWidth - cBoxWidth, iPageHeight - cBoxHeight, iPageWidth, iPageHeight - cBoxHeight ) ;
    DrawLine( gTitlePen, iPageWidth - cBoxWidth, iPageHeight - cBoxHeight + cSchGrid, iPageWidth, iPageHeight - cBoxHeight + cSchGrid ) ;
    DrawLine( gTitlePen, iPageWidth - cBoxWidth, iPageHeight - cBoxHeight + 9 * cSchGrid, iPageWidth, iPageHeight - cBoxHeight + 9 * cSchGrid ) ;
    DrawLine( gTitlePen, iPageWidth - cBoxWidth, iPageHeight - cBoxHeight + 12 * cSchGrid, iPageWidth, iPageHeight - cBoxHeight + 12 * cSchGrid ) ;
    DrawLine( gTitlePen, iPageWidth - cBoxWidth, iPageHeight - cBoxHeight, iPageWidth - cBoxWidth, iPageHeight ) ;
    DrawLine( gTitlePen, iPageWidth - 8 * cSchGrid, iPageHeight - cBoxHeight + 9 * cSchGrid, iPageWidth - 8 * cSchGrid, iPageHeight ) ;
    ptF.X := iPageWidth - cBoxWidth ;
    ptF.Y := iPageHeight - cBoxHeight + 9 * cSchGrid ;
    s := 'Title: ' + Name ;
    DrawString( s, length( s ), gFontTitle, ptF, gTextBrush ) ;
    ptF.X := iPageWidth - cBoxWidth ;
    ptF.Y := iPageHeight - cBoxHeight + 11 * cSchGrid ;
    s := Format( 'Sheet %d of %d (%s, %s)', [ fNumber + 1, ( Parent as TMedaSchematicViewer ).PageCount, UpperCase( fSize ), PortraitLandscape[ fLandscape ] ] ) ;
    DrawString( s, length( s ), gFontTitle, ptF, gTextBrush ) ;
    ptF.X := iPageWidth - cBoxWidth ;
    ptF.Y := iPageHeight - cBoxHeight + 12 * cSchGrid ;
    s := 'Modified: ' + FormatDateTime( '', fModified ) ;
    DrawString( s, length( s ), gFontTitle, ptF, gTextBrush ) ;
    ptF.X := iPageWidth - 8 * cSchGrid ;
    ptF.Y := iPageHeight - cBoxHeight + 12 * cSchGrid ;
    s := 'Rev: ' + Revision ;
    DrawString( s, length( s ), gFontTitle, ptF, gTextBrush ) ;
    TranslateTransform( -cSchGrid, -cSchGrid ) ;
  end ;
end ;

procedure TMedaPage.SetSelection( aFlag : TMedaState ) ;
begin
  inherited ;
  if aFlag = triTrue then
    TMedaSchematicViewer( Parent ).CurrentPage := Self ;
  Invalidate ;
end ;

procedure TMedaPage.SetLandscape( const Value : boolean ) ;
var
  iPageWidth, iPageHeight : integer ;
begin
  FLandscape := Value ;
  if fLandscape then begin
    iPageWidth := max( fPageWidth, fPageHeight ) ;
    iPageHeight := min( fPageWidth, fPageHeight ) ;
  end
  else begin
    iPageWidth := min( fPageWidth, fPageHeight ) ;
    iPageHeight := max( fPageWidth, fPageHeight ) ;
  end ;
  fPageWidth := iPageWidth ;
  fPageHeight := iPageHeight ;
  Invalidate ;
end ;

procedure TMedaPage.SetSize( Value : string ) ;
begin
  fSize := Value ;
  Value := LowerCase( fSize ) ;
  if Value = 'a5' then begin
    fPageWidth := cPageHeight ;
    fPageHeight := cPageWidth div 2 ;
  end
  else if Value = 'a4' then begin
    fPageWidth := cPageWidth ;
    fPageHeight := cPageHeight ;
  end
  else if Value = 'a3' then begin
    fPageWidth := cPageHeight * 2 ;
    fPageHeight := cPageWidth ;
  end
  else if Value = 'a2' then begin
    fPageWidth := cPageWidth * 2 ;
    fPageHeight := cPageHeight * 2 ;
  end ;
  Invalidate ;
end ;

procedure TMedaPage.Update ;
begin
  inherited ;
end ;

{ TMedaSchInterface }

constructor TMedaSchInterface.Create( aParent : TMedaSchematicViewer ) ;
begin
  inherited Create ;
  fParent := aParent ;
  Expanded := True ;
end ;

function TMedaSchInterface.GetChildCount : integer ;
begin
  Result := fParent.PageCount ;
end ;

function TMedaSchInterface.GetIcon : TIconType ;
begin
  Result := iconPCB ;
end ;

function TMedaSchInterface.GetChild( index : integer ) : TMedaViewable ;
begin
  Result := fParent.Pages[ index ] ;
end ;

function TMedaSchInterface.GetName : string ;
begin
  Result := 'Schematic View' ;
end ;

function TMedaSchInterface.GetPopupMenu : TPopupMenu ;
begin
  Result := TPopupMenu( Accept( SchematicPopupVisitor as TSchematicPopupVisitor ) ) ;
end ;

function TMedaSchInterface.GetText( aColumn : integer ) : string ;
begin
  Result := '' ;
  case aColumn of
    0 : Result := GetName ;
  end ;
end ;

function TMedaSchInterface.GetColor : TGPColor ;
begin
  Result := aclMedaSchematicView ;
end ;

function TMedaSchInterface.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

procedure TMedaSchInterface.Mark ;
var
  i                 : integer ;
begin
  inherited ;
  for i := 0 to fParent.PageCount - 1 do
    if assigned( fParent.Pages[ i ] ) then
      fParent.Pages[ i ].Mark ;
end ;

procedure TMedaSchInterface.Update ;
begin

end ;

{ TMedaSchematicViewer }

function TMedaSchematicViewer.AddPage( aSize : string = 'a4' ; aLandscape : boolean = True ) : TMedaPage ;
var
  l                 : TMedaPageNumber ;
begin
  Result := nil ;
  if fMedaPages.Count <= High( TMedaPageNumber ) then begin
    l := fMedaPages.Count ;
    Result := TMedaPage.Create ;
    fMedaPages.Add( Result ) ;
    Result.Size := aSize ;
    Result.Landscape := aLandscape ;
    Result.fNumber := l ;
    Result.Parent := Self ;
    Result.Name := 'Page ' + IntToStr( l ) ;
    CurrentPageIndex := l ;
  end ;
  fProjectView.Update ;
  Invalidate ;
end ;

procedure TMedaSchematicViewer.DeletePage( aPageIndex : TMedaPageNumber ) ;
begin
  fMedaPages.Delete( aPageIndex ) ;
  if aPageIndex >= fMedaPages.Count then
    dec( aPageIndex ) ;
  CurrentPageIndex := aPageIndex ;
  Invalidate ;
end ;

constructor TMedaSchematicViewer.Create( AOwner : TComponent ) ;
begin
  inherited Create( AOwner ) ;
  fName := 'page' ;
  Color := clMoneyGreen ;
  fProjectView := TMedaSchInterface.Create( Self ) ;

  fBackBrush := TGPSolidBrush.Create( aclBackSch ) ;
  fGridPen0 := TGPPen.Create( aclGridSch0 ) ;
  fGridPen1 := TGPPen.Create( aclGridSch1 ) ;
  fGridPen2 := TGPPen.Create( aclGridSch2 ) ;

  fMouseFactory := TMouseSchematicFactory.Create ;

  fMedaPages := TObjectlist.Create( False ) ;
  fGrid := cSchGrid ;
  fDensity := 1 ;
end ;

destructor TMedaSchematicViewer.Destroy ;
begin
  fMedaPages.Free ;
  inherited ;
end ;

function TMedaSchematicViewer.PageByID( aPage : TGUID ) : TMedaPage ;
var
  i                 : integer ;
begin
  Result := nil ;
  for i := 0 to PageCount - 1 do
    if IsEqualGUID( Pages[ i ].ID, aPage ) then begin
      Result := Pages[ i ] ;
      Exit ;
    end ;
end ;

function TMedaSchematicViewer.PageByName( aPage : string ) : TMedaPage ;
var
  i                 : integer ;
begin
  Result := nil ;
  for i := 0 to PageCount - 1 do
    if Pages[ i ].Name = aPage then begin
      Result := Pages[ i ] ;
      Exit ;
    end ;
end ;

procedure TMedaSchematicViewer.Clear ;
begin
  fMedaPages.Clear ;
  Invalidate ;
end ;

procedure TMedaSchematicViewer.CreateGraphics ;
begin
  if not assigned( fGraphics ) then
    fGraphics := TMedaGraphics.Create( Canvas.Handle ) ;
end ;

function TMedaSchematicViewer.HitTest( aPoint : TGPPointF ) : TMedaViewList ;
var
  i                 : TMedaPageNumber ;
begin
  CreateGraphics ;
  try
    Result := inherited HitTest( aPoint ) ;
    fGraphics.TranslateTransform( -fGraphics.Offset.X, -fGraphics.Offset.Y ) ;
    fGraphics.ScaleTransform( fZoom, fZoom ) ;
    for i := 0 to PageCount - 1 do
      if assigned( Pages[ i ] ) and ( Pages[ i ].GetSelection <> triFalse ) then begin
        Pages[ i ].HitTest( aPoint, fGraphics, Result ) ;
        Break ;
      end ;
  finally
    FreeGraphics ;
  end ;
end ;

procedure TMedaSchematicViewer.Paint ;
var
  i                 : TMedaPageNumber ;
begin
  CreateGraphics ;
  try
    inherited ;
    if assigned( fGraphics.MemGraphics ) then begin
      fGraphics.MemGraphics.TranslateTransform( -fGraphics.Offset.X, -fGraphics.Offset.Y ) ;
      fGraphics.MemGraphics.ScaleTransform( fZoom, fZoom ) ;
      for i := 0 to PageCount - 1 do
        if assigned( Pages[ i ] ) and ( Pages[ i ].GetSelection <> triFalse ) then begin
          Pages[ i ].PaintAt( fGraphics ) ;
          Break ;
        end ;
      if assigned( Rats ) then
        Rats( fGraphics ) ;
      DrawBuffer ;
    end ;
  finally
    FreeGraphics ;
  end ;
end ;

function TMedaSchematicViewer.CanZoomIn : boolean ;
begin
  Result := CanPlace and ( fZoom < 2 * cSchGrid )
end ;

function TMedaSchematicViewer.CanZoomOut : boolean ;
begin
  Result := CanPlace and ( fZoom > 1 / cSchGrid ) ;
end ;

function TMedaSchematicViewer.CanPlace : boolean ;
begin
  Result := fMedaPages.Count > 0 ;
end ;

function TMedaSchematicViewer.GetCurrentPageIndex : TMedaPageNumber ;
var
  i                 : TMedaPageNumber ;
begin
  Result := -1 ;
  for i := 0 to PageCount - 1 do
    if assigned( Pages[ i ] ) and ( Pages[ i ].GetSelection <> triFalse ) then begin
      Result := i ;
      Break ;
    end ;
end ;

procedure TMedaSchematicViewer.SetCurrentPageIndex( const Value : TMedaPageNumber ) ;
begin
  if assigned( Pages[ Value ] ) then
    CurrentPage := Pages[ Value ] ;
  Invalidate ;
end ;

function TMedaSchematicViewer.GetCurrentPage : TMedaPage ;
var
  i                 : TMedaPageNumber ;
begin
  Result := nil ;
  for i := 0 to PageCount - 1 do
    if assigned( Pages[ i ] ) and ( Pages[ i ].GetSelection <> triFalse ) then begin
      Result := Pages[ i ] ;
      Break ;
    end ;
end ;

procedure TMedaSchematicViewer.SetCurrentPage( const aPage : TMedaPage ) ;
var
  i                 : TMedaPageNumber ;
begin
  for i := 0 to PageCount - 1 do
    if assigned( Pages[ i ] ) and ( Pages[ i ] <> aPage ) then
      Pages[ i ].SetSelection( triFalse ) ;
  if aPage.GetSelection = triFalse then
    aPage.SetSelection( triTrue ) ;
  fCurrentWidth := aPage.fPageWidth ;
  fCurrentHeight := aPage.fPageHeight ;
  SetScrollBounds( 0, 0, Round( fCurrentWidth * fZoom ), Round( fCurrentHeight * fZoom ) ) ;
  Invalidate ;
end ;

function TMedaSchematicViewer.GetPages( index : TMedaPageNumber ) : TMedaPage ;
begin
  Result := nil ;
  if ( -1 < index ) and ( index < fMedaPages.Count ) then
    Result := TMedaPage( fMedaPages[ index ] ) ;
end ;

function TMedaSchematicViewer.PageCount : integer ;
begin
  Result := fMedaPages.Count ;
end ;

procedure TMedaSchematicViewer.Remove( aObject : TMedaViewable ) ;
begin
  fMedaPages.Remove( aObject ) ;
end ;

initialization
  vsbSchematicViewer := TMedaSchematicViewer.Create( nil ) ;

  gTitlePen := TGPPen.Create( aclPin, 1 ) ;
  gTitlePen.SetStartCap( LineCapRound ) ;
  gTitlePen.SetEndCap( LineCapRound ) ;

  gFontFamily := TGPFontFamily.Create( 'Bitstream Vera Sans Mono' ) ;
  gFontTitle := TGPFont.Create( gFontFamily, cSchGrid, FontStyleRegular, UnitPixel ) ;
  gTextBrush := TGPSolidBrush.Create( aclTextSch ) ;

finalization
  gTextBrush.Free ;
  gFontTitle.Free ;
  gTitlePen.Free ;
  gFontFamily.Free ;
  vsbSchematicViewer.Free ;

end.

